home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / C / PROPERTY.C < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-24  |  4.3 KB  |  138 lines
  1. /* PROPERTY.C
  2.  ************************************************************************
  3.  *                                    *
  4.  *        PC Scheme/Geneva 4.00 Borland C code            *
  5.  *                                    *
  6.  * (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7.  * (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8.  *                                    *
  9.  *----------------------------------------------------------------------*
  10.  *                                    *
  11.  *            Property List Support                *
  12.  *                                    *
  13.  *----------------------------------------------------------------------*
  14.  *                                    *
  15.  * Created by: John Jensen        Date: 1985            *
  16.  * Revision history:                            *
  17.  * - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  18.  *                                    *
  19.  *                    ``In nomine omnipotentii dei''    *
  20.  ************************************************************************/
  21.  
  22. /* Note:  The property list structure has the following representation:
  23.  * 
  24.  *                     +-----------+   +-----------+   +-----------+
  25.  *                     | sym |   o-|-->|prop |   o-|-->| val |   o-|--> etc.
  26.  *                     +-----------+   +-----------+   +-----------+
  27.  * +------------+      ^
  28.  * |            |      |               +--> next symbol's entry
  29.  * |  Property  |      |               |
  30.  * | List Hash  |   +-----------+   +-----------+
  31.  * |   Table    |-->|  ^  |   o-|-->|  ^  |   o-|--> next entry in hash chain
  32.  * |            |   +-----------+   +-----------+
  33.  * +------------+
  34.  */
  35.  
  36. #include    <ctype.h>
  37. #include    "scheme.h"
  38.  
  39. #define FOUND 1
  40. #define NOT_FOUND 0
  41.  
  42. /************************************************************************/
  43. /* Get Property Value                            */
  44. /************************************************************************/
  45. void    get_prop(REGPTR sym, REGPTR prop)
  46. {
  47.     sym_search(sym);
  48.     if (prop_search(sym, prop) == FOUND) {
  49.         take_cadr(sym);
  50.     } else {        /* property (or symbol) not found-- return nil */
  51.         *sym = nil_reg;
  52.     }
  53. }
  54.  
  55. /************************************************************************/
  56. /* Get Property List                            */
  57. /************************************************************************/
  58. int    prop_list(REGPTR name)
  59. {
  60.     int    retstat = 0;    /* the return status */
  61.  
  62.     if (ptype[CORRPAGE(name->page)] == SYMTYPE) {
  63.         sym_search(name);
  64.         take_cdr(name);
  65.     } else {
  66.         set_src_error("PROPLIST", 1, name);
  67.         retstat = -1;
  68.     }
  69.     return    retstat;
  70. }
  71.  
  72. /************************************************************************/
  73. /* Put Property Value                            */
  74. /************************************************************************/
  75. int    put_prop(REGPTR name, REGPTR value, REGPTR prop)
  76. {
  77.     int    hash_value;    /* hash key for the symbol */
  78.  
  79.     tmp_reg = *name;
  80.  
  81.     if (ptype[CORRPAGE(name->page)] == SYMTYPE) {
  82.         sym_search(&tmp_reg);
  83.         if (tmp_reg.page) {    /* symbol found in property list table */
  84.             if (prop_search(&tmp_reg, prop) == FOUND) {
  85.                 take_cdr(&tmp_reg);
  86.                 put_ptr(CORRPAGE(tmp_reg.page), tmp_reg.disp, value->page, value->disp);
  87.             } else {/* property not present in symbol's property list */
  88.                 *name = tmp_reg;
  89.                 take_cdr(name);
  90.                 cons(name, value, name);
  91.                 cons(name, prop, name);
  92.                 put_ptr(CORRPAGE(tmp_reg.page), tmp_reg.disp + 3, name->page, name->disp);
  93.             }
  94.         } else {    /* symbol wasn't found in property list table */
  95.             cons(&tmp_reg, value, &nil_reg);
  96.             cons(&tmp_reg, prop, &tmp_reg);
  97.             cons(&tmp_reg, name, &tmp_reg);
  98.             hash_value = sym_hash(name);
  99.             name->page = prop_page[hash_value];
  100.             name->disp = prop_disp[hash_value];
  101.             cons(&tmp_reg, &tmp_reg, name);
  102.             prop_page[hash_value] = tmp_reg.page;
  103.             prop_disp[hash_value] = tmp_reg.disp;
  104.         }
  105.         *name = *value;
  106.     } else {        /* name operand is not a symbol */
  107.         set_src_error("PUTPROP", 3, name, value, prop);
  108.         return    -1;
  109.     }
  110.     return    0;
  111. }
  112.  
  113. /************************************************************************/
  114. /* Remove Property                             */
  115. /************************************************************************/
  116. void    rem_prop(REGPTR sym, REGPTR prop)
  117. {
  118.     REG        search, temp;
  119.  
  120.     sym_search(sym);
  121.     if (sym->page) {
  122.         search = *sym;
  123.         while (search.page) {
  124.             temp = search;
  125.             take_cadr(&temp);
  126.             if ( eq( &temp, prop ) ) {
  127.                 temp = search;
  128.                 take_cddr(&temp);
  129.                 take_cdr(&temp);
  130.                 put_ptr(CORRPAGE(search.page), search.disp + 3, temp.page, temp.disp);
  131.                 break;
  132.             } else {
  133.                 take_cddr(&search);
  134.             }
  135.         }
  136.     }
  137. }
  138.